perm filename FILT2.F4[IRC,LCS] blob
sn#153752 filedate 1977-03-30 generic text, type T, neo UTF8
00100 C****** PROGRAMMED "FILTER"
00200
00300 SUBROUTINE SUBR
00400 COMMON /INS/ INST(27),BG(60)
00500 COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF
00600 C INST=INSTRUMENT NAME, BG=BEGIN TIME OF EACH INST.
00700 C INUM=INST# IPAR=PARAM# BT=BASIC TIME P1 WHEN SUBROUTINE IS
00800 C CALLED, IF IREST IS <0, THAT NOTE WILL BE A REST.
00900 C NOTE #S IN SUBROUTINE: (1-84) C4=37 FS4=43 C5=49 F1=86
01000 C F15=100 (NO F16!)
01100
01200 DIMENSION A(30)
01210 DATA SPRD/.5/
01300
01400 IF(INUM.NE.1)GO TO 3
01500 5 I=P(3)
01600 X=I
01700 C THIS GETS RID OF TRAILING DECIMALS IF RAND SELECTION!
01800
01900 IF(I.NE.N)GO TO 4
02000 C SKIP IF NO REPTITION
02100 P(3)=P(3)+1
02200 C MOVES UP HALF STEP
02300 GO TO 5
02400 C GO BACK AND PUT IT AWAY AGAIN.
02500 4 N=I
02600 C SAVE IT FOR NEXT TIME AROUND.
02700
02710 IF(N.EQ.56)P(5)=86
02720 C USE FUNCTION F1 WHEN G IS HIT
02730
02740 X=30.868*2**(X/12)
02770 C X=FREQ. IN HZ. BASED ON NOTE NUM. IN P3.
02785
02800 Q=0
02900 IF(N.LT.P(8).OR.N.GT.P(9).OR.P(7).EQ.0)RETURN
03000 C RETURN IF NOTHING SPECIAL TO BE DONE
03100
03110 SPRD=SPRD+.5
03120 P(2)=P(2)*SPRD
03130 C P2 WILL GET SPREAD MORE EACH TIME
03140
03200 Q=P(7)
03300 P(5)=86
03400 C STORE AWAY P7, CHANGE ENV. TO SOSTENUTO.
03900
04000 RETURN
04100
04150 3 IF(P(1).GT.0)IREST=-1
04175 C THE REST FLAG
04200
04210 IF(Q.NE.0)GO TO 10
04220 C JUMP IF WE HIP SPECIAL AREA
04230
04300 C HARM. 1 (IN P4 AND P5) WON'T CHANGE
04400 C ALL OTHERS CAN.
04500 DO 1 K=7,19,2
04600 Y=X*P(K-1)
04700 C GETS TRUE FREQ. OF EACH HARMONIC
04800
04900 IF(Y.LT.3800)GO TO 1
05000 C IF IT IS LESS THAN 3800 DON'T WORRY ABOUT IT.
05100
05200 Y=(4600-Y)/800
05300 C WHAT PERCENTAGE OF THE DIST. TO 4600 IS IT?
05400
05500 IF(Y.LT.0)Y=0
05600 C IF IT IS OVER 4600 WIPE OUT THIS HARMONIC.
05700
05800 P(K)=P(K)*Y
05900 C SCALE THIS HARMONIC ACCORDINGLY
06500
06600 1 CONTINUE
06650
06700 GO TO 9
06800 C NOTHING MORE TO BE DONE HERE.
06900
07100 10 P(18)=33
07200 P(16)=25
07300 P(14)=17
07400 C CHANGE HARMS 6,7,8 TO 19,21,23
07500
07600 P(19)=2
07700 P(17)=2
07800 P(15)=2
07810
07820 9 DO 6 K=7,19,2
07830 IF(P(K).EQ.A(K))GO TO 6
07840 IREST=0
07850 C IF DIFFERENT VALUE FOR ANY HARM. AMPL. TURN OFF REST FLAG.
07860 6 A(K)=P(K)
07870 C STORE THIS HARM'S AMPL. FOR THE NEXT TIME.
08000 RETURN
08100 END
08200
08300 C TYPICAL INPUT FOR "FILTER" ROUTINE.
08400 C FILT
08500 C TOOT 0 10;
08600 C P2 .1;
08700 C P3 MOV/3 C1,G3 G3,G7/ 2 C5,A C,A/ 1.5 C,A G2,E3;
08750 C 3.5 C2,A6 C2,A6*;
08800 C P4 1000/P5 F2/P6 F3;
08900 C P10 1;
08950 C P7 MO/1 0 0/ 2 1 1/ 5.2 0 0/ 1.5 1 1*;
08975 C P8 MO/8.2 C3 C/ 1.5 C4,C2*;
08987 C P9 MO/8.2 C4,C/ 1.5 C4,A6*;
09000 C END;
09100
09200 C DUMMY INVIS 0 10;
09300 C P2 P2;
09400 C P3 "SYNTH(F3);";
09500 C P4 1;
09600 C P5 1;
09700 C P6 2;
09800 C P7 1;
09900 C P8 3/ P9 1/ P10 4/ P11 1;
10000 C P12 5/ P13 1/ P14 6/ P15 1/ P16 7/ P17 1;
10100 C P18 8/ P19 1/ P20 SUBN 999/END;